* Listing 7
* file:  PrintGraph.for


*
* PrintGraph Fortran Program
*
* Copyright (c) 1987 Mark E. McBride
*                    211 N. University Ave.
*                    Oxford, OH  45056
*
*
* Main Program
*
	program PrintGraph
	
	implicit none			! helps keep us out of trouble

*
* Reset the pathname to reflect your disk setup
*
	include XP40-6:MS Fortran:Include Files:desk.inc
	include XP40-6:MS Fortran:Include Files:dialog.inc
	include XP40-6:MS Fortran:Include Files:event.inc
	include XP40-6:MS Fortran:Include Files:menu.inc
	include XP40-6:MS Fortran:Include Files:memory.inc
	include XP40-6:MS Fortran:Include Files:misc.inc
	include XP40-6:MS Fortran:Include Files:quickdraw.inc
	include XP40-6:MS Fortran:Include Files:textedit.inc
	include XP40-6:MS Fortran:Include Files:utilities.inc
	include XP40-6:MS Fortran:Include Files:window.inc
	include XP40-6:MS Fortran:Include Files:prport.inc
	include XP40-6:MS Fortran:Include Files:prdefs.inc
	
*	include XP40-6:MS Fortran:Include Files:a5Glob.inc
*
* Local Variables
*
	integer*4 mouseloc		! mouse location from FINDWINDOW
	integer*4 eventmask		! specifies the events of interest
	integer*4 window		! to get default window closed
	integer*4 rnum,rnum1		! for use in random numbers

*
* Include the common variables
*
	include XP40-6:MS Fortran:printgraph.com
*
* lock in control proc handler in memory
*
	window=ctlprc(0,0)
*
*  Flush the event manager before calling
*
	eventmask = -1
*
*  Close MacFortran I/O window 
*
	window=toolbx(FRONTWINDOW)
	call toolbx(CLOSEWINDOW,window)
*
*  Call Text Edit and Dialog initilization.
*
	call toolbx(TEINIT)
	call toolbx(INITDIALOGS, 0)
*
*  Setup a print record for use later and fill in default values
*
	prrechdl=toolbx(NEWHANDLE,iPrintSize)
	call prport(PROPEN)
	call prport(PRINTDEFAULT,prrechdl)
	call prport(PRCLOSE)
*
*  Setup colors array
*
	colors(1)=33
	colors(2)=30
	colors(3)=205
	colors(4)=341
	colors(5)=409
	colors(6)=273
	colors(7)=137
	colors(8)=69
*
* Build the menu from the resource file 
*
	menuhandle=toolbx(GETMENU,Apple)
	call toolbx(INSERTMENU,menuhandle,0)
	call toolbx(ADDRESMENU,menuhandle,'DRVR')
	menuhandle=toolbx(GETMENU,File)
	call toolbx(INSERTMENU,menuhandle,0)
	menuhandle=toolbx(GETMENU,Edit)
	call toolbx(INSERTMENU,menuhandle,0)
	call toolbx(DRAWMENUBAR)
*
* setup rectangles 
*
	call toolbx(SETRECT,rect,0,0,342,512)
*
* setup watch cursor for later use
*
	curshandle=toolbx(GETCURSOR,4)
	call toolbx(HLOCK,curshandle)
	cursptr=long(curshandle)
	call toolbx(BLOCKMOVE,cursptr,toolbx(PTR,watch(1)),68)
	call toolbx(HUNLOCK,curshandle)
*
* seed the random number generator
*
	call toolbx(HIDECURSOR)
*	long(toolbx(GETGLOBAL)+RANDSEED)=toolbx(TICKCOUNT)
	call reset
	call toolbx(SHOWCURSOR)
*
* Setup values for Hilbert curve
*
	rnum=2			! randomly set color
	do while (rnum=2)	! don't get white
	  rnum1=toolbx(RANDOM)
	  rnum=int((abs(rnum1)/32768.0)*8+1)
	repeat
	colorpick=colors(rnum)
	
	rnum=toolbx(RANDOM)	! randomly set line size
	linepick=int((abs(rnum)/32768.0)*4+1)
	
	rnum=2
	do while (rnum<3)
	  rnum1=toolbx(RANDOM)	! randomly set Hilbert order
	  rnum=int((abs(rnum1)/32768.0)*6+1)
	repeat
	n=rnum

	call Drawing
*
* main event processing loop
*
	do
*
* handle system jobs
*
	call toolbx(SYSTEMTASK)
*
* handle events
*
	if (toolbx(GETNEXTEVENT,eventmask,eventrecord)) then
	  select case (what)
	    case (1)	! mouse down
	      mouseloc = toolbx(FINDWINDOW,where,window)
	      if (mouseloc=1) then	! in menu bar
		call menus
	      else if (mouseloc=2) then  ! systemwindow
	        call toolbx(SYSTEMCLICK,eventrecord,window)
	      end if
	    case default	! ignore other events
	  end select
	end if
	repeat			! repeat for another event
*
* end of the main program
*
	end

*
* menus: a mouse down event was detected in the menu area
*
	subroutine menus
	
	implicit none
*
* Reset the pathname to reflect your disk setup
*
	include XP40-6:MS Fortran:Include Files:desk.inc
	include XP40-6:MS Fortran:Include Files:dialog.inc
	include XP40-6:MS Fortran:Include Files:event.inc
	include XP40-6:MS Fortran:Include Files:menu.inc
	include XP40-6:MS Fortran:Include Files:memory.inc
	include XP40-6:MS Fortran:Include Files:quickdraw.inc
	include XP40-6:MS Fortran:Include Files:misc.inc
	include XP40-6:MS Fortran:Include Files:textedit.inc
	include XP40-6:MS Fortran:Include Files:utilities.inc
	include XP40-6:MS Fortran:Include Files:window.inc
	include XP40-6:MS Fortran:Include Files:prport.inc
	include XP40-6:MS Fortran:Include Files:prdefs.inc

	include XP40-6:MS Fortran:Include Files:OSUtilities.inc
	include XP40-6:MS Fortran:Include Files:scrap.inc
	
*
* local variables for menu subroutine
*
	character*80 name,pname
	integer*4 refnum,item4,i,j,size,count
	integer*2 OSErr
	logical ok
*
* variable for conversion to pascal type strings
*
	character*256 str255
*
*  variables for making menu selections
*
	integer*2 menuselection(2)	! menu selection information
	integer*4 menudata		! for use left of equals sign
	equivalence (menuselection,menudata)
*
* Include the common variables
*
	include XP40-6:MS Fortran:printgraph.com
*
* Start of Subroutine
*
	menudata=toolbx(MENUSELECT,where)		! get selected menu data
	item4=menuselection(2)				! convert to 4 bytes
	select case (menuselection(1))			! which menu?
	  case (File)	! File menu
	    menuhandle=toolbx(GETMHANDLE,File)
	    select case (menuselection(2))
	      case(PSetUp)	! Page Setup selected
	        call prport(PROPEN)
	      	ok=prport(PRSTLDIALOG,prrechdl)
		call prport(PRCLOSE)
	      case(PrintPic)	! Print Hiblert curve selected
	      	call PrintIt
	      case(Quit)	! Quit selected
		stop
	      case default
	      end select
	   case (Apple)	  ! Apple menu
	     menuhandle=toolbx(GETMHANDLE,Apple)
	     select case(menuselection(2))
	       case(About)	! About item selected
	         call toolbx(GETPORT,oldPort)
		 dlg=toolbx(GETNEWDIALOG,200,0,-1)
		 call toolbx(SETPORT,dlg)
		 call FrameDItem
		 ditemh=0
		 while (ditemh<>1)
		   call toolbx(MODALDIALOG,0,ditemh)
		 repeat
		 call toolbx(SETPORT,oldPort)
		 call toolbx(DISPOSEDIALOG,dlg)
	       case default	! desk acc selected
	         call toolbx(GETITEM,menuhandle,item4,name)
		 refnum=toolbx(OPENDSKACC,name)
	       end select
	   case (Edit)	  ! Edit menu
	     if (.not. toolbx(SYSTEMEDIT,item4-1)) then
	     end if
	   case default		! just playing with the mouse
	end select
	call toolbx(HILITEMENU,0)
	end


*
*  Drawing:  create hilbert picture of order n using recursive techniques
*            This is an adaptation of Michael Ackerman's algorithim given
*            in Byte, June 1986, pages 137-148.
*
	subroutine Drawing
	
	implicit none
*
* Reset the pathname to reflect your disk setup
*
	include XP40-6:MS Fortran:Include Files:quickdraw.inc
	include XP40-6:MS Fortran:Include Files:memory.inc
	include XP40-6:MS Fortran:Include Files:misc.inc
	include XP40-6:MS Fortran:Include Files:window.inc
*
* include common variables
*
	include XP40-6:MS Fortran:printgraph.com

	call toolbx(SETCURSOR,watch)

	call toolbx(SETRECT,rect,0,0,342,512)
	
	pichandle=toolbx(OPENPICTURE,rect)

	call toolbx(FORECOLOR,colorpick)
	call toolbx(BACKCOLOR,colors(White))
	call toolbx(PENSIZE,linepick,linepick)
	rder=n
	dy=512/((2**rder-1)+12)
	turn=-1
	dx=0
	x=10
	y=10
	call toolbx(MOVETO,10,10)
	call Graph

	call toolbx(CLOSEPICTURE)

	call toolbx(FORECOLOR,colors(Black))
	call toolbx(PENSIZE,1,1)
	
	call toolbx(INITCURSOR)

	end


*
* Graph:  draws a hilbert curve of order rder recursively
*
	subroutine Graph

	implicit none
*
* Reset the pathname to reflect your disk setup
*
	include XP40-6:MS Fortran:Include Files:quickdraw.inc
	include XP40-6:MS Fortran:Include Files:window.inc
*
* include common variables
*
	include XP40-6:MS Fortran:printgraph.com

	integer*4 temp

	rder=rder-1
	turn=-turn
	temp=dy
	dy=-turn*dx
	dx=turn*temp
	if (rder.gt.0) call Graph
	x=x+dx
	y=y+dy
	call toolbx(LINETO,x,y)
	turn=-turn
	temp=dy
	dy=-turn*dx
	dx=turn*temp
	if (rder.gt.0) call Graph
	x=x+dx
	y=y+dy
	call toolbx(LINETO,x,y)
	if (rder.gt.0) call Graph
	temp=dy
	dy=-turn*dx
	dx=turn*temp
	turn=-turn
	x=x+dx
	y=y+dy
	call toolbx(LINETO,x,y)
	if (rder.gt.0) call Graph
	temp=dy
	dy=-turn*dx
	dx=turn*temp
	turn=-turn
	rder=rder+1

	end	
	

*
* Subroutine to print out contents of graph window
*
	Subroutine PrintIt

	implicit none
*
* Reset the pathname to reflect your disk setup
*
	include XP40-6:MS Fortran:Include Files:quickdraw.inc
	include XP40-6:MS Fortran:Include Files:dialog.inc
	include XP40-6:MS Fortran:Include Files:memory.inc
	include XP40-6:MS Fortran:Include Files:misc.inc
	include XP40-6:MS Fortran:Include Files:window.inc
	include XP40-6:MS Fortran:Include Files:prport.inc
	include XP40-6:MS Fortran:Include Files:prdefs.inc
*
* other local variables
*
	integer*2 qflag			! Variable to hold bjDocLoop flag
	integer*4 temp,i
	integer*2 srect(4),margins(4)
	integer*4 rPageptr
	logical ok
	integer*4 canproc
*
* variable for conversion to pascal type strings
*
	character*256 str255,str1
*
* print manager structures
*
	integer*4 theprport		! Pointer to printer grafport
	integer*1 thestrec(26)		! Status record for PRPICFILE
*
* include common variables
*
	include XP40-6:MS Fortran:printgraph.com
*
* start print job
*
	call toolbx(HLOCK,prrechdl)
	ok=.false.
	call prport(PROPEN)
	ok=prport(PRJOBDIALOG,prrechdl)
	if (ok) then
*
* set up idle proc
*
	  call toolbx(GETPORT,oldPort)
 	  call toolbx(SETCURSOR,watch)
	  canproc=ctlprc(ftrack,0)
	  long(long(prrechdl)+prJob+pIdleProc)=canproc
	  
	  rPageptr=long(prrechdl)+prInfo+rPage
	  call toolbx(BLOCKMOVE,rPageptr,toolbx(PTR,srect(1)),8)
	  
	  dlg=toolbx(GETNEWDIALOG,1010,0,-1)
	  str1=str255('Hilbert Order '//char(48+n))
	  call toolbx(PARAMTEXT,str1,'','','')
	  call toolbx(DRAWDIALOG,dlg)
	  call toolbx(SETPORT,dlg)
	  call FrameDItem

	  call toolbx(INITCURSOR)
*
* start printing
*
	  theprport = prport(PROPENDOC, prrechdl, 0, 0)
	  if (prport(PRERROR) .NE. 0) then
	    write(9,*) "Printer error ",prport(PRERROR)
	    goto 10
	  endif

	  call prport(PROPENPAGE,theprport,0)

	  if (prport(PRERROR) .NE. 0) then
	    write(9,*) "Printer error ",prport(PRERROR)
	    goto 20
	  endif
	
	  call toolbx(DRAWPICTURE,pichandle,rect)
	  
20	  call prport(PRCLOSEPAGE, theprport)
10	  call prport(PRCLOSEDOC, theprport)

	  qflag = byte(long(prrechdl)+prJob+bJDocLoop)
*
* If the print method is spooled, the actual printing still needs to be done.
*
	  if ((qflag = bSpoolLoop) .AND. (prport(PRERROR) = 0)) then
	    call prport(PRPICFILE, prrechdl, 0, 0, 0, 
     +		  toolbx(PTR,thestrec))
	  endif

	  if (prport(PRERROR) .NE. 0) then
	    write(9,*) "Printer error ",prport(PRERROR)
	  endif
 	  call toolbx(DISPOSEDIALOG,dlg)
 	  call toolbx(SETPORT,oldPort)
	endif
	
	call prport(PRCLOSE)
	call toolbx(HUNLOCK,prrechdl)
	
	end

*
*  Frame rounded rectangle, sets the default item
*
	subroutine FrameDItem

	implicit none
*
* Reset the pathname to reflect your disk setup
*
	include XP40-6:MS Fortran:Include Files:quickdraw.inc
	include XP40-6:MS Fortran:Include Files:dialog.inc
*
* include common variables
*
	include XP40-6:MS Fortran:printgraph.com
*
* local variables
*
	integer*4 dLog
	integer*2 iBox(4)
	integer*4 iBox4(4)
	integer*2 iType
	integer*4 iHandle
	integer*1 oldPenState(18)
	
	call toolbx(GETPENSTATE,oldPenState)
	call toolbx(GETDITEM,dlg,1,iType,iHandle,iBox)
	call toolbx(INSETRECT,iBox,-4,-4)
	call toolbx(PENSIZE,3,3)
	call toolbx(FRAMEROUNDRECT,iBox,16,16)
	call toolbx(SETPENSTATE,oldPenState)
	
	end
*
*  str255: converts a FORTRAN string to a Pascal LSTRING
*
	character*256 function str255(string)

	character*(*) string
	
	str255 = char(len(trim(string)))//string

	end


* This is the idleProc for the Print Manager used in the
* printit subsubroutine.

* Normally, a pointer to the arguments passed to a control proc
* routine by the toolbox is passed in argptr.  This is done
* since the glue routine used by ctlprc to interface the
* toolbox to FORTRAN has no way of knowing what kind of
* procedure this is (control actionProc, dialog filterProc,
* etc.), and therefore no way of knowing how many parameters
* to expect.  argptr points to the last argument (partCode)
* as pushed on the stack by the toolbox; preceding arguments
* are at higher addresses.

     	subroutine ftrack(argptr)

	implicit none			! Declare all variables.
	integer argptr			! Pointer to arguments.
					! but there are none
	logical bool
	integer*2 item
	integer*4 cancelitem
	integer*4 dlgptr,toolbx
	integer*4 mDownMask,KeyDownMask,keyDown
	parameter (cancelitem=1)
	parameter (mDownMask=2,KeyDownMask=8,keyDown=3)
	
	integer*2 theEvent(8)
	integer*2 what
	integer*4 message
	integer*4 when
	integer*2 where(2)
	integer*2 modifiers	

*
* Reset the pathname to reflect your disk setup
*
	include XP40-6:MS Fortran:Include Files:event.inc
	include XP40-6:MS Fortran:Include Files:dialog.inc
	include XP40-6:MS Fortran:Include Files:prport.inc
	include XP40-6:MS Fortran:Include Files:prdefs.inc
	
	bool=toolbx(GETNEXTEVENT,mDownMask+KeyDownMask,theEvent)
	item=0
	if ((what=keyDown).and.(mod(message,256) = 13)) then
	  item=cancelitem
	else if toolbx(ISDIALOGEVENT,theEvent) then
	  bool=toolbx(DIALOGSELECT,theEvent,dlgptr,item)
	end if
	if (item=cancelitem) then
	  call prport(PRSETERROR,128)	! set print abort error
	end if

	return
     	end
